home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / closin1r / vbsnow.cls < prev    next >
Text File  |  1999-08-25  |  3KB  |  84 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "VBSnow"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' Maximum number of flakes, alter for more or less flakes
  15. Private Const NUMFLAKES = 100
  16. ' Alter SCREENX and SCREENY to desired screen width and height
  17. Private Const SCREENX = 320
  18. Private Const SCREENY = 240
  19.  
  20. ' The actual type defining a single flake
  21. Private Type tFlake
  22.     X As Integer
  23.     Y As Integer
  24.     N As Integer
  25. End Type
  26.  
  27. ' An array of flakes
  28. Private Flakes(NUMFLAKES) As tFlake
  29.  
  30. Private Sub Class_Initialize()
  31.     For i = LBound(Flakes) To UBound(Flakes)
  32.         Randomize
  33.         Flakes(i).X = Int(Rnd() * (SCREENX - 1))
  34.         Flakes(i).Y = Int(Rnd() * (SCREENY - 1))
  35.         Flakes(i).N = Int(Rnd() * 4) + 1
  36.     Next i
  37. End Sub
  38.  
  39. Public Sub ReInit()
  40.     Call Class_Initialize
  41. End Sub
  42.  
  43. Public Sub DrawFlakes(frm As Form)
  44.     Dim btm As Long, rgt As Long, lft As Long
  45.     
  46.     For i = 0 To UBound(Flakes)
  47.         ' Read bottom, lower left and lower right pixels
  48.         btm = GetPixel(frm.hDC, Flakes(i).X, Flakes(i).Y + 1)
  49.         lft = GetPixel(frm.hDC, Flakes(i).X - 1, Flakes(i).Y + 1)
  50.         rgt = GetPixel(frm.hDC, Flakes(i).X + 1, Flakes(i).Y + 1)
  51.         
  52.         ' Delete current position
  53.         SetPixel frm.hDC, Flakes(i).X, Flakes(i).Y, RGB(0, 0, 0)
  54.         
  55.         If Flakes(i).Y >= SCREENY - 1 Then
  56.             SetPixel frm.hDC, Flakes(i).X, Flakes(i).Y, RGB(Flakes(i).N * 51, Flakes(i).N * 51, Flakes(i).N * 51)
  57.             Flakes(i).Y = 0
  58.             Flakes(i).X = Int(Rnd() * (SCREENX - 1))
  59.         End If
  60.         If btm = RGB(0, 0, 0) Then
  61.             Flakes(i).Y = Flakes(i).Y + 1
  62.             SetPixel frm.hDC, Flakes(i).X, Flakes(i).Y, RGB(Flakes(i).N * 51, Flakes(i).N * 51, Flakes(i).N * 51)
  63.             GoTo Done
  64.         Else
  65.             If rgt = RGB(0, 0, 0) Then
  66.                 Flakes(i).X = Flakes(i).X + 1
  67.                 Flakes(i).Y = Flakes(i).Y + 1
  68.                 SetPixel frm.hDC, Flakes(i).X, Flakes(i).Y, RGB(Flakes(i).N * 51, Flakes(i).N * 51, Flakes(i).N * 51)
  69.                 GoTo Done
  70.             ElseIf lft = RGB(0, 0, 0) Then
  71.                 Flakes(i).X = Flakes(i).X - 1
  72.                 Flakes(i).Y = Flakes(i).Y + 1
  73.                 SetPixel frm.hDC, Flakes(i).X, Flakes(i).Y, RGB(Flakes(i).N * 51, Flakes(i).N * 51, Flakes(i).N * 51)
  74.                 GoTo Done
  75.             Else
  76.                 SetPixel frm.hDC, Flakes(i).X, Flakes(i).Y, RGB(Flakes(i).N * 51, Flakes(i).N * 51, Flakes(i).N * 51)
  77.                 Flakes(i).Y = 0
  78.                 GoTo Done
  79.             End If
  80.         End If
  81. Done:
  82.     Next i
  83. End Sub
  84.